unit uxMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
ComCtrls, ExtCtrls, Dialogs, SyncObjs, StrUtils, ShellAPI,
uxSelectionFrame, uxCtrls, uxSettings;

//------------------------------------------------------------------------------
type

//** TMainForm **//
TClient = class(TForm)
  HexView: THexView;
  SelectInfo: TSelectInfo;
  PacketList: TPacketList;
  Toolbar: TPanel;
  StatusBar: TStatusBar;
  BtnYulgang: TButtonEx;
  BtnStart: TPngButton;
  BtnPause: TPngButton;
  BtnClear: TButtonEx;
  BtnOpen: TButtonEx;
  BtnSave: TButtonEx;
  CkbSend: TCheckBox;
  CkbRecv: TCheckBox;
  CkbShowNew: TCheckBox;
  OpenDialog: TOpenDialog;
  SaveDialog: TSaveDialog;
  BtnSettings: TButtonEx;
  procedure BtnPause_OnClick(Sender: TObject);
  procedure HexView_OnSelectionChanged(Sender: TObject; SelStart,
      SelLength: Integer);
  procedure BtnYulgang_OnClick(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure OptionsChange(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
  procedure ShowNewChange(Sender: TObject);
  procedure BtnClear_OnClick(Sender: TObject);
  procedure BtnOpen_OnClick(Sender: TObject);
  procedure BtnSave_OnClick(Sender: TObject);
  procedure PacketList_OnSelectionChanged(Sender: TObject);
  procedure BtnStart_OnClick(Sender: TObject);
  procedure BtnSettings_OnClick(Sender: TObject);
private
  AppPath: String;
  Title: TCaption;
  EventMsg: Cardinal;
  DataMsg: Cardinal;
  MapFileHandle: THandle;
  PView: PByte;
  YBClient: HWND;
  OptionFlag: Cardinal;
  CmdFlag: Cardinal;
  CanClear: Boolean;
  NewData: Boolean;
  procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  procedure ButtonState(State: Cardinal);
  procedure CreateMemoryMappedFile;
  procedure DeleteMemoryMappedFile;
  procedure DataHandler(ViewOfs: Cardinal; Count: Word; CMD: Word);
  procedure InitButtonState;
  procedure InjectSpy;
  procedure ProcessMouseWheel(var Msg: tagMSG);
  procedure SetDebugPrivilege;
protected
  procedure Paint; override;
  procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
public
  procedure SetMsg(const Msg: String);
  procedure SetErrMsg(const Msg: String);
end;

//------------------------------------------------------------------------------
var

AppMsg: Cardinal;
Client: TClient;

implementation

{$R *.dfm}

//------------------------------------------------------------------------------
const

(* Button State *)
BS_START    = 1;
BS_PAUSE    = 2;
BS_CONTINUE = 3;
BS_CLEAR    = 4;
BS_OPEN     = 5;

(* EventMsg's WParam *)
EV_INITIALIZE       = $100001;  //LParam: Succeed = 0, Failed = -1
EV_SETCOMMAND       = $100002;  //LParam: Command
EV_RELEASEDATA      = $100003;  //LParam: Length of data, in bytes
EV_MAPOVERFLOW      = $100004;
EV_YBCLIENT_DESTROY = $100005;

YB_CLIENT: PWideChar = 'YB_OnlineClient';

YG_PARAM: array [0..5] of PWideChar =
(
  '203.144.179.131 16100',
  '203.144.179.132 16100',
  '203.144.179.133 16100',
  '203.144.179.131 16101',
  '203.144.179.132 16101',
  '203.144.179.133 16101'
);

SIGNATURE: DWORD = $00504759; // 'YGP' + Null-character

SpyInitFunc: AnsiString = 'Initialize';

MMF_NAME  = 'YGP::MMF/zedoic@gmail.com';
MMF_SIZE  = 512000;


//==============================================================================
//** TMainForm
//------------------------------------------------------------------------------
procedure TClient.AppMessage(var Msg: tagMSG; var Handled: Boolean);
var
  Size: Cardinal;
begin
  if Msg.message = DataMsg then
  begin
    // LParam.Lo = CMD
    // LParam.Hi = Size
    Size := Msg.lParam shr 16;
    DataHandler(Msg.wParam, Size , Msg.lParam and $FFFF);
    PostMessage(YBClient, EventMsg, EV_RELEASEDATA, Size);
    Handled := True;
    Exit;
  end;

  if Msg.message = EventMsg then
  begin
    Handled := True;
    (* EV_MAPOVERFLOW *)
    if Msg.wParam = EV_MAPOVERFLOW then
    begin
      SetErrMsg('!! SHARED MEMORY OVERFLOW.');
      Exit;
    end;
    (* EV_YBCLIENT_DESTROY *)
    if Msg.wParam = EV_YBCLIENT_DESTROY then
    begin
      SetMsg('TERMINATE.');
      YBClient := 0;
      ButtonState(BS_PAUSE);
      DeleteMemoryMappedFile;
      Exit;
    end;
    (* EV_INITIALIZE *)
    if Msg.wParam =  EV_INITIALIZE then
    begin
      if Msg.lParam <> 0 then
      begin
        SetErrMsg('!! SPY INITIALIZATION FAILED.');
        Exit;
      end;

      CreateMemoryMappedFile;

      if MapFileHandle <> 0 then
        CmdFlag := OptionFlag
      else
      begin
        CmdFlag := 0;
        SetErrMsg('!! CAN NOT OPEN FILE MAPPING.');
      end;

      PostMessage(YBClient, EventMsg, EV_SETCOMMAND, CmdFlag);
    end;

    Exit;
  end;

  if Msg.message = WM_MOUSEWHEEL then
    ProcessMouseWheel(Msg)
  else
  if Msg.Message = AppMsg then
  begin
    Application.Restore;
    SetForeGroundWindow(Handle);
    Handled := true;
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.BtnClear_OnClick(Sender: TObject);
begin
  PacketList.Clear;
  Caption := Title;
  ButtonState(BS_CLEAR);
end;
//------------------------------------------------------------------------------
procedure TClient.BtnOpen_OnClick(Sender: TObject);
var
  F: File;
  Count, i: Integer;
  Size: Word;
  FileSign: DWORD;
  Packet: TPacket;
begin
  if OpenDialog.Execute(Handle) then
  begin
    FileMode := fmOpenRead or fmShareDenyNone;
    AssignFile(F, OpenDialog.FileName);
    try
      Reset(F, 1);
      try
        BlockRead(F, FileSign, 4);

        if FileSign <> SIGNATURE then raise Exception.Create('');

        BlockRead(F, Count, 4);
        PacketList.Clear;
        PacketList.BeginUpdate;

        for i := 0 to Count - 1 do
        begin
          BlockRead(F, Size, 2);
          GetMem(Packet, Size + 8);
          PWord(Packet)^ := Size;
          BlockRead(F, Packet[2], Size + 6);
          PacketList.Add(Packet);
        end;

        PacketList.EndUpdate;
        NewData := False;
        ButtonState(BS_OPEN);
        Caption := Title + ' [ ' + ExtractFileName(OpenDialog.FileName) + ' ]';
      finally
        CloseFile(F);
      end;
    except
      PacketList.Clear;
      ButtonState(BS_CLEAR);
      SetErrMsg('!! ERROR LOADING PACKET FILE');
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.BtnPause_OnClick(Sender: TObject);
begin
  if (YBClient <> 0) and (CmdFlag <> 0) then
  begin
    CmdFlag := 0;
    PostMessage(YBClient, EventMsg, EV_SETCOMMAND, CmdFlag);
  end;
  ButtonState(BS_PAUSE);
end;
//------------------------------------------------------------------------------
procedure TClient.BtnSave_OnClick(Sender: TObject);
var
  F: File;
  Count, i, Size: Integer;
  Packet: TPacket;
begin
  if SaveDialog.Execute(Handle) then
  begin
    FileMode := fmOpenWrite or fmShareDenyWrite;
    AssignFile(F, SaveDialog.FileName);
    try
      Rewrite(F, 1);
      try
        BlockWrite(F, SIGNATURE, 4);
        Count := PacketList.Count;
        BlockWrite(F, Count, 4);

        for i := 0 to Count - 1 do
        begin
          Packet := PacketList[i];
          Size := PWord(Packet)^ + 8;
          BlockWrite(F, Packet[0], Size);
        end;

        Caption := Title + ' [ ' + ExtractFileName(SaveDialog.FileName) + ' ]';
      finally
        CloseFile(F);
      end;
    except
      SetErrMsg('!! ERROR SAVING PACKET FILE.');
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.BtnSettings_OnClick(Sender: TObject);
begin
  try
    SettingsDialog := TSettingsDialog.Create(Self);
    try
      SettingsDialog.ShowModal;
    finally
      SettingsDialog.Free;
    end;
  except
    SetErrMsg('!! CAN NOT OPEN SETTINGS DIALOG.');
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.BtnStart_OnClick(Sender: TObject);
begin
  SetErrMsg('');

  if YBClient = 0 then
  begin
    YBClient := FindWindow(nil, YB_CLIENT);

    if YBClient = 0 then
      SetErrMsg('YULGANG NOT RUNNING.')
    else
    begin
      try
        InjectSpy;
        PacketList.Clear;
        ButtonState(BS_START);
        SetMsg('STARTED');
      except
        SetErrMsg('!! SPY INITIALIZATION FAILED.');
        YBClient := 0;
        ButtonState(BS_PAUSE);
      end;
    end;

  end
  else
  begin
    if not NewData then PacketList.Clear;

    ButtonState(BS_CONTINUE);

    if CmdFlag <> OptionFlag then
    begin
      CmdFlag := OptionFlag;
      PostMessage(YBClient, EventMsg, EV_SETCOMMAND, CmdFlag);
    end;

  end;
end;
//------------------------------------------------------------------------------
procedure TClient.BtnYulgang_OnClick(Sender: TObject);
var
  Pi: Integer;
  Path: String;
begin
  Randomize;
  Pi := Random(6);
  Path := ExtractFilePath(ThaiClientExe);

  if Path <> '' then
    ShellExecute(0, 'open', 'ThaiClient.exe', YG_PARAM[Pi],
        PWideChar(Path), SW_SHOWNORMAL);
end;
//------------------------------------------------------------------------------
procedure TClient.ButtonState(State: Cardinal);
begin
  case State of
    BS_START:
      begin
        BtnStart.Enabled := False;
        BtnPause.Enabled := True;
        BtnSave.Enabled := False;
        BtnOpen.Enabled := False;
        BtnClear.Enabled := False;
      end;

    BS_PAUSE:
      begin
        BtnStart.Enabled := True;
        BtnPause.Enabled := False;
        BtnSave.Enabled := CanClear;
        BtnOpen.Enabled := True;
      end;

    BS_CONTINUE:
      begin
        BtnStart.Enabled := False;
        BtnPause.Enabled := True;
        BtnSave.Enabled := False;
        BtnOpen.Enabled := False;
      end;

    BS_CLEAR:
      begin
        CanClear := False;
        BtnClear.Enabled := False;
        BtnSave.Enabled := False;
      end;

    BS_OPEN:
      begin
        CanClear := PacketList.Count > 0;
        BtnClear.Enabled := CanClear;
        BtnSave.Enabled := CanClear;
      end;
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.CreateMemoryMappedFile;
begin
  if MapFileHandle = 0 then
    MapFileHandle := OpenFileMapping(FILE_MAP_READ, False, MMF_NAME);

  if MapFileHandle <> 0 then
  begin
    PView := MapViewOfFile(MapFileHandle, FILE_MAP_READ, 0, 0, 0);
    if PView = nil then
    begin
      CloseHandle(MapFileHandle);
      MapFileHandle := 0;
    end;
  end;

end;
//------------------------------------------------------------------------------
procedure TClient.DataHandler(ViewOfs: Cardinal; Count: Word; CMD: Word);
var
  P, Packet: TPacket;
  BytesCopy: Cardinal;
begin
  GetMem(Packet, Count + 8);

  try
    PWord(Packet + 0)^ := Count;
    PWord(Packet + 2)^ := CMD;
    PCardinal(Packet + 4)^ := GetTime32;

    if ViewOfs + Count > MMF_SIZE then
      BytesCopy := MMF_SIZE - ViewOfs
    else
      BytesCopy := Count;

    P := Packet + 8;

    CopyMemory(P, PView + ViewOfs, BytesCopy);
    Dec(Count, BytesCopy);

    if Count > 0 then
    begin
      Inc(P, BytesCopy);
      CopyMemory(P, PView, Count);
    end;

    PacketList.Add(Packet);
    NewData := True;

    if not CanClear then
    begin
      CanClear := True;
      BtnClear.Enabled := True;
    end;

  except
    FreeMem(Packet);
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.DeleteMemoryMappedFile;
begin
  if MapFileHandle <> 0 then
  begin

    if PView <> nil then
    begin
      UnmapViewOfFile(PView);
      PView := nil;
    end;

    CloseHandle(MapFileHandle);
    MapFileHandle := 0;
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
  AppPath := ExtractFilePath(Application.ExeName);
  SetDebugPrivilege;
  YBClient := 0;
  InitButtonState;
  CkbSend.Checked := True;
  CkbRecv.Checked := True;
  CkbSend.Tag := (1 shl 0) or (1 shl 4);
  CkbRecv.Tag := (1 shl 2) or (1 shl 6);
  Title := Caption;
  OptionFlag := (1 shl 0) or (1 shl 2) or (1 shl 4) or (1 shl 6);
  CmdFlag := OptionFlag;
  Settings.Create('Settings.ini');

  if Settings.Load then
  begin
    EventMsg := RegisterWindowMessage('YGP::EventMsg/zedoic@gmail.com');
    DataMsg := RegisterWindowMessage('YGP::DataMsg/zedoic@gmail.com');
  end
  else
  begin
    OptionFlag := 0;
    CmdFlag := 0;
    ButtonState(BS_PAUSE);
    SetErrMsg('!! CAN NOT LOAD SETTINGS FILE.');
  end;

  MapFileHandle := 0;
  PView := nil;
  NewData := False;
end;
//------------------------------------------------------------------------------
procedure TClient.FormDestroy(Sender: TObject);
begin
  if (YBClient <> 0) and (CmdFlag <> 0) then
    PostMessage(YBClient, EventMsg, EV_SETCOMMAND, 0);

  Settings.Save;
  DeleteMemoryMappedFile;
end;
//------------------------------------------------------------------------------
procedure TClient.HexView_OnSelectionChanged(Sender: TObject;
    SelStart, SelLength: Integer);
var
  Data: Pointer;
begin
  if SelLength = 0 then
    SelectInfo.Clear
  else
  begin
    Data := HexView.GetSelectData(SelStart);
    SelectInfo.SetSelection(Data, SelStart, SelLength);
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.InitButtonState;
begin
  CanClear := False;
  BtnStart.Enabled := True;
  BtnPause.Enabled := False;
  BtnClear.Enabled := CanClear;
  BtnSave.Enabled := False;
  BtnOpen.Enabled := True;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
{$O-}
procedure LoadSpy;
asm
  pushfd
	pushad

	mov     ebp, [esp + 40] //ebp -> Parameter

	lea		  edi, [ebp + 56]
	push		edi             //'Spy.dll'
	call		[ebp]	          //GetModuleHandleA('Spy.dll')
	mov		  [ebp], eax

  test    eax, eax
	jne		  @@loc_initialize

	lea     edi, [ebp + 56]
	push		edi             //'Spy.dll'
	call		[ebp + 4]       //LoadLibraryA('Spy.dll')
	mov		  [ebp], eax

  test	  eax, eax
	je			@@loc_exit

@@loc_initialize:

  (* Initialize *)
	lea     edi, [ebp + 36]
	push		edi             //'Initialize'
	push		[ebp]	          //SpyModuleHandle
	call		[ebp + 8]       //GetProcAddress(SpyModuleHandle, 'Initialize')

  test	  eax, eax
	je			@@loc_exit

  lea     edi, [ebp + 12] //Param: PCardinal;
  push    edi
                          // Param[0] = MyClient
                          // Param[1] = YBClient
                          // Param[2] = Breakpoint-SEND1
                          // Param[3] = Breakpoint-RECV1
                          // Param[4] = Breakpoint-SEND2
                          // Param[5] = Breakpoint-RECV2
	call		eax             //Initialize(Param)

@@loc_exit:

	popad
	popfd

	ret		4

end;
//------------------------------------------------------------------------------
procedure _LoadSpy;
begin
end;
{$O+}
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------

procedure TClient.InjectSpy;
var
  ProcessId, ThreadId: Cardinal;
  ProcessHandle: THandle;
  RemoteThread: THandle;
  Protect, KN32: Cardinal;
  BytesCount, Size, SizeOfCode, SizeOfParam: Cardinal;
  Data: array [0..511] of Byte;
  PData: PByte;
  SpyName: AnsiString;
  Remote, Entry: Pointer;
begin
  GetWindowThreadProcessId(YBClient, ProcessId);
  ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId);

  if ProcessHandle = 0 then Exit;

  SizeOfCode := Cardinal(@_LoadSpy) - Cardinal(@LoadSpy);
  SizeOfParam := 400;
  Size := SizeOfCode + SizeOfParam;
  ZeroMemory(@Data, Size);
  KN32 := GetModuleHandle('kernel32.dll');
  PData := @Data;
  PCardinal(PData + 0)^ := Cardinal(GetProcAddress(KN32, 'GetModuleHandleA'));
  PCardinal(PData + 4)^ := Cardinal(GetProcAddress(KN32, 'LoadLibraryA'));
  PCardinal(PData + 8)^ := Cardinal(GetProcAddress(KN32, 'GetProcAddress'));
  PCardinal(PData + 12)^ := Handle;
  PCardinal(PData + 16)^ := YBClient;
  PCardinal(PData + 20)^ := Settings.BreakPoints[CMD_SEND1].Addr;
  PCardinal(PData + 24)^ := Settings.BreakPoints[CMD_RECV1].Addr;
  PCardinal(PData + 28)^ := Settings.BreakPoints[CMD_SEND2].Addr;
  PCardinal(PData + 32)^ := Settings.BreakPoints[CMD_RECV2].Addr;
  CopyMemory(PData + 36, @SpyInitFunc[1], 10);
  SpyName := AnsiString(AppPath + 'Spy.dll');
  CopyMemory(PData + 56, @SpyName[1], Length(SpyName));
  CopyMemory(PData + SizeOfParam, @LoadSpy, SizeOfCode);
  Remote := VirtualAllocEx(ProcessHandle, nil, Size,
      MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE);

  if Remote <> nil then
  begin
    VirtualProtectEx(ProcessHandle, Remote, Size,
        PAGE_EXECUTE_READWRITE, Protect);
    WriteProcessMemory(ProcessHandle, Remote, @Data, Size, BytesCount);
    FlushInstructionCache(ProcessHandle, Remote, Size);
    VirtualProtectEx(ProcessHandle, Remote, Size, Protect, nil);
    Entry := Pointer(Cardinal(Remote) + SizeOfParam);
    RemoteThread := CreateRemoteThread(ProcessHandle, nil, 0, Entry,
        Remote, 0, ThreadId);

    if RemoteThread <> 0 then WaitForSingleObject(RemoteThread, INFINITE);

    VirtualFreeEx(ProcessHandle, Remote, 0, MEM_RELEASE);
    CloseHandle(RemoteThread);
  end;

  CloseHandle(ProcessHandle);
end;
//------------------------------------------------------------------------------
procedure TClient.OptionsChange(Sender: TObject);
var
  CheckBox: TCheckBox;
  Flag: Cardinal;
begin
  CheckBox := Sender as TCheckBox;
  Flag := CheckBox.Tag;

  if CheckBox.Checked then
    OptionFlag := OptionFlag or Flag
  else
    OptionFlag := OptionFlag and (not Flag);

  if (YBClient <> 0) and (CmdFlag <> OptionFlag) then
  begin
    CmdFlag := OptionFlag;
    PostMessage(YBClient, EventMsg, EV_SETCOMMAND, CmdFlag);
  end;

end;
//------------------------------------------------------------------------------
procedure TClient.PacketList_OnSelectionChanged(Sender: TObject);
var
  Packet: TPacket;
begin
  with PacketList do
  begin
    if ItemIndex < 0 then
      HexView.Clear
    else
    begin
      Packet := Item[ItemIndex];
      HexView.AssignData(Packet + 8, PWord(Packet)^);
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.Paint;
begin
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(ClipRect);
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.ProcessMouseWheel(var Msg: tagMSG);
var
  C: TWinControl;
begin
  C := FindVCLWindow(Msg.pt);

  if C <> nil then Msg.hwnd := C.Handle;

end;
//------------------------------------------------------------------------------
procedure TClient.SetDebugPrivilege;
var
  TP: TTokenPrivileges;
  LD: Int64;
  TokenHandle: THandle;
  ReturnLength: Cardinal;
begin
	if OpenProcessToken(GetCurrentProcess,
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle) then
  begin
    if LookupPrivilegeValue(nil, PWideChar('SeDebugPrivilege'), LD) then
    begin
      TP.PrivilegeCount := 1;
      TP.Privileges[0].Luid := LD;
      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      AdjustTokenPrivileges(TokenHandle, False, TP, SizeOf(TP), nil,
          ReturnLength);
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TClient.SetErrMsg(const Msg: String);
begin
  StatusBar.Panels[2].Text := Msg;
end;
//------------------------------------------------------------------------------
procedure TClient.SetMsg(const Msg: string);
begin
  StatusBar.Panels[1].Text := Msg;
end;
//------------------------------------------------------------------------------
procedure TClient.ShowNewChange(Sender: TObject);
begin
  PacketList.ShowNewItem := CkbShowNew.Checked;
end;
//------------------------------------------------------------------------------
procedure TClient.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;
//------------------------------------------------------------------------------

end.
